(defparameter *indent* 0)

(defun indent-by-step ()
  (let ((indent (make-string *indent* :initial-element (code-char #x20))))
    indent))
  

(define-condition malformated-msgpack-error (error)
  ((text :initarg :text :reader text)))

(defun read-bigendian-int16 (in)
  (let ((h1 (read-byte in nil))
        (h0 (read-byte in nil))
        (num 0))
    (setf (ldb (byte 8 8) num) h1)
    (setf (ldb (byte 8 0) num) h0)
    num))

(defun read-bigendian-int32 (in)
  (let ((h3 (read-byte in nil))
        (h2 (read-byte in nil))
        (h1 (read-byte in nil))
        (h0 (read-byte in nil))
        (num 0))
    (setf (ldb (byte 8 24) num) h3)
    (setf (ldb (byte 8 16) num) h2)
    (setf (ldb (byte 8 8) num) h1)
    (setf (ldb (byte 8 0) num) h0)
    num))


(defun handle-positive-fixint (byte &optional (stream *standard-output*))
  "
   handle the positive fix int8 type from data stream
"
  (format stream "int8: ")
  (format stream "~x~%" byte))

(defun handle-fixmap (byte in &optional (stream *standard-output*))
  "
   handle the fixmap type from data stream
"
  (format stream "~&~afixmap:~%" (indent-by-step))
  (let ((times (ldb (byte 4 0) byte)))
    (format stream "~&~a{~%" (indent-by-step))
    (incf *indent* 4)
    (dotimes (cnt times)
      (let ((index (read-byte in nil))
            (ctrlByte (read-byte in nil)))
        (format stream "~aindex: ~x ctrlByte: ~x " (indent-by-step) index ctrlByte)
        (handle-control-byte ctrlByte in))))
  (incf *indent* -4)
  (format stream "~&~a}~%" (indent-by-step)))

(defun handle-fixarray (byte in &optional (stream *standard-output*))
  "
    handle fixarray type from stream
"
  (format stream "fixarray: ")
  (let ((byte byte))
    (cond
      ;;; fixarray
      ((= #x9 (ldb (byte 4 4) byte))
       (let ((times (ldb (byte 4 0) byte)))
         (dotimes (cnt times)
           (let ((ctrlByte (read-byte in nil)))
             (handle-control-byte ctrlByte in)))))
      ;;; array 16
      ((= #xdc byte)
       (let ((cnt (read-bigendian-int16 in)))
         (dotimes (i cnt)
           (let ((ctrlByte (read-byte in nil)))
             (handle-control-byte ctrlByte in)))))
      ;;; array 32
      ((= #xdd byte)
       (let ((cnt (read-bigendian-int32 in)))
         (dotimes (i cnt)
           (let ((ctrlByte (read-byte in nil)))
             (handle-control-byte ctrlByte in)))))))
  (format stream "~%"))

(defun handle-fixstr (byte in &optional (stream *standard-output*))
  "
  handle the fix str
"
  (format stream "fixstr: ")
  (let* ((byte byte)
         (num (ldb (byte 5 0) byte))
         (buf (list)))
    (dotimes (i num)
      (push (read-byte in nil) buf))
    (format stream "~{~x~^, ~}" (reverse buf))
    (format stream "~%")))

(defun handle-nil-byte (in &optional (stream *standard-output*))
  (declare (ignore in))
  (format stream " <nil>~%"))

(defun handle-false-byte (in &optional (stream *standard-output*))
  (declare (ignore in))
  (format stream " <false>~%"))

(defun handle-true-byte (in &optional (stream *standard-output*))
  (declare (ignore in))
  (format stream " <true>~%"))

(defun handle-bin8 (in &optional (stream *standard-output*))
  (format stream "bin8 data: ")
  (let ((num (read-byte in nil)))
    (dotimes (i num)
      (format stream "~x" (read-byte in nil))))
  (format stream "~%"))

(defun handle-bin16 (in &optional (stream *standard-output*))
  (format stream "bin16 data: ")
  (let ((num (read-bigendian-int16 in)))
    (dotimes (i num)
      (format stream "~x" (read-bigendian-int16 in))))
  (format stream "~%"))

(defun handle-bin32 (in &optional (stream *standard-output*))
  (format stream "bin32 data: ")
  (let ((num (read-bigendian-int32 in)))
    (dotimes (i num)
      (format stream "~x" (read-bigendian-int32 in))))
  (format stream "~%"))

(defun handle-ext8 (in &optional (stream *standard-output*))
  (format stream "ext8 data: ")
  (let ((len (read-byte in nil))
        (type (read-byte in nil)))
    (format stream "type: ~x data: " type)
    (dotimes (i len)
      (format stream "~x" (read-byte in nil))))
  (format stream "~%"))

(defun handle-ext16 (in &optional (stream *standard-output*))
  (format stream "ext16 data: ")
  (let ((num (read-bigendian-int16 in)))
    (dotimes (i num)
      (format stream "~x" (read-bigendian-int16 in))))
  (format stream "~%"))


(defun handle-ext32 (in &optional (stream *standard-output*))
  (format stream "ext32 data: ")
  (let ((num (read-bigendian-int32 in))
        (type (read-byte in)))
    (format stream "type: ~x data: " type)
    (dotimes (i num)
      (format stream "~x" (read-byte in nil))))
  (format stream "~%"))

(defun handle-float32 (in &optional (stream *standard-output*))
  (format stream "float32 data: ")
  (dotimes (i 4)
    (format stream "~x" (read-byte in nil)))
  (format stream "~%"))

(defun handle-float64 (in &optional (stream *standard-output*))
  (format stream "float64 data: ")
  (dotimes (i 8)
    (format stream "~x" (read-byte in nil)))
  (format stream "~%"))

(defun handle-int8 (in &optional (stream *standard-output*))
  (format stream "int8 data: ")
  (format stream "~x~%" (read-byte in nil)))

(defun handle-int16 (in &optional (stream *standard-output*))
  (format stream "int16 data: ")
  (dotimes (i 2)
    (format stream "~x" (read-byte in nil)))
  (format stream "~%"))

(defun handle-int32 (in &optional (stream *standard-output*))
  (format stream "int32 data: ")
  (dotimes (i 4)
    (format stream "~x" (read-byte in nil)))
  (format stream "~%"))

(defun handle-int64 (in &optional (stream *standard-output*))
  (format stream "int64 data: ")
  (dotimes (i 8)
    (format stream "~x" (read-byte in nil)))
  (format stream "~%"))

(defun handle-uint8 (in &optional (stream *standard-output*))
  (format stream "uint8 data: ")
  (format stream "~x~%" (read-byte in nil)))

(defun handle-uint16 (in &optional (stream *standard-output*))
  (format stream "uint16 data: ")
  (dotimes (i 2)
    (format stream "~x" (read-byte in nil)))
  (format stream "~%"))

(defun handle-uint32 (in &optional (stream *standard-output*))
  (format stream "uint32 data: ")
  (dotimes (i 4)
    (format stream "~x" (read-byte in nil)))
  (format stream "~%"))

(defun handle-uint64 (in &optional (stream *standard-output*))
  (format stream "uint64 data: ")
  (dotimes (i 8)
    (format stream "~x" (read-byte in nil)))
  (format stream "~%"))

(defun handle-fixext1 (in &optional (stream *standard-output*))
  (format stream "fixext1 data: ")
  (let ((type (read-byte in nil))
        (data (read-byte in nil)))
    (format stream "~x ~x~%" type data)))

(defun handle-fixext2 (in &optional (stream *standard-output*))
  (format stream "fixext2 data: ")
  (let ((type (read-byte in nil))
        (h1 (read-byte in nil))
        (h0 (read-byte in nil)))
    (format stream "~x ~x ~x~%" type h1 h0)))

(defun handle-fixext4 (in &optional (stream *standard-output*))
  (format stream "fixext4 data: ")
  (let ((type (read-byte in nil))
        (h3 (read-byte in nil))
        (h2 (read-byte in nil))
        (h1 (read-byte in nil))
        (h0 (read-byte in nil)))
    (format stream "~x ~x ~x ~x ~x ~%" type h3 h2 h1 h0)))

(defun handle-fixext8 (in &optional (stream *standard-output*))
  (format stream "fixext8 data: ")
  (let ((type (read-byte in nil)))
    (format stream "type: ~x data: " type)
    (dotimes (i 8)
      (format stream "~x" (read-byte in nil))))
  (format stream "~%"))

(defun handle-fixext16 (in &optional (stream *standard-output*))
  (format stream "fixext16 data: ")
  (let ((type (read-byte in nil)))
    (format stream "type: ~x data: " type)
    (dotimes (i 16)
      (format stream "~x" (read-byte in nil))))
  (format stream "~%"))

(defun handle-str8 (in &optional (stream *standard-output*))
  (format stream "str8 data: ")
  (let ((len (read-byte in nil))
        (buf (list)))
    (dotimes (i len)
      (push (read-byte in nil) buf))
    (format stream "~{~C~^, ~}" (reverse buf)))
  (format stream "~%"))

(defun handle-str16 (in &optional (stream *standard-output*))
  (format stream "str16 data: ")
  (let ((len (read-bigendian-int16 in))
        (buf (list)))
    (dotimes (i len)
      (push (read-byte in nil) buf))
    (format stream "~{~x~^, ~}" (reverse buf)))
  (format stream "~%"))

(defun handle-str32 (in &optional (stream *standard-output*))
  (format stream "str32 data: ")
  (let ((len (read-bigendian-int32 in))
        (buf (list)))
    (dotimes (i len)
      (push (read-byte in nil) buf))
    (format stream "~{~x~^, ~}" (reverse buf)))
  (format stream "~%"))

(defun handle-array16 (in &optional (stream *standard-output*))
  (format stream "array16 data: ")
  (let ((len (read-bigendian-int16 in)))
    (dotimes (i len)
      (let ((byte (read-byte in nil)))
        (handle-control-byte byte in))))
  (format stream "~%"))

(defun handle-array32 (in &optional (stream *standard-output*))
  (format stream "array32 data: ")
  (let ((len (read-bigendian-int32 in)))
    (dotimes (i len)
      (let ((byte (read-byte in nil)))
        (handle-control-byte byte in))))
  (format stream "~%"))


(defun handle-map16 (in &optional (stream *standard-output*))
  (format stream "~amap16:~%" (indent-by-step))
  (let ((num (read-bigendian-int16 in)))
    (format stream "~&~a{~%" (indent-by-step))
    (incf *indent* 4)
    (dotimes (i num)
      (let ((index (read-byte in nil))
            (byte (read-byte in nil)))
        (format stream "~aindex: ~x ctrlByte: ~x" (indent-by-step) index byte)
        (handle-control-byte byte in))))
  (incf *indent* -4)
  (format stream "~&~a}~%" (indent-by-step)))

(defun handle-map32 (in &optional (stream *standard-output*))
  (format stream "~amap32:~%" (indent-by-step))
  (let ((num (read-bigendian-int32 in)))
    (format stream "~&~a{~%" (indent-by-step))
    (incf *indent* 4)
    (dotimes (i num)
      (let ((index (read-byte in nil))
            (byte (read-byte in nil)))
        (format stream "~aindex: ~x ctrlByte: ~x " (indent-by-step) index byte)
        (handle-control-byte byte in))))
  (incf *indent* -4)
  (format stream "~&~a}~%" (indent-by-step)))

(defun handle-negative-fixint (in &optional (stream *standard-output*))
  (format stream "negative-fixint data: ")
  (let ((data (ldb (byte 5 0) (read-byte in nil))))
    (format stream "~x~%" data)))

(defun handle-control-byte (byte in)
  (cond
    ((null byte)
     (error 'malformated-msgpack-error :text "unefficient data for msgpack!"))
    ((<= byte #x7f)
     (handle-positive-fixint byte))
    ((and (>= byte #x80) (<= byte #x8f))
       (handle-fixmap byte in))
    ((and (>= byte #x90) (<= byte #x9f))
     (handle-fixarray byte in))
    ((and (>= byte #xa0) (<= byte #xbf))
     (handle-fixstr byte in))
    ((= byte #xc0)
     (handle-nil-byte in))
    ((= byte #xc1)
     (error 'malformated-msgpack-error :text "the control byte is never used!"))
    ((= byte #xc2)
     (handle-false-byte in))
    ((= byte #xc3)
     (handle-true-byte in))
    ((= byte #xc4)
     (handle-bin8 in))
    ((= byte #xc5)
     (handle-bin16 in))
    ((= byte #xc6)
     (handle-bin32 in))
    ((= byte #xc7)
     (handle-ext8 in))
    ((= byte #xc8)
     (handle-ext16 in))
    ((= byte #xc9)
     (handle-ext32 in))
    ((= byte #xca)
     (handle-float32 in))
    ((= byte #xcb)
     (handle-float64 in))
    ((= byte #xcc)
     (handle-uint8 in))
    ((= byte #xcd)
     (handle-uint16 in))
    ((= byte #xce)
     (handle-uint32 in))
    ((= byte #xcf)
     (handle-uint64 in))
    ((= byte #xd0)
     (handle-int8 in))
    ((= byte #xd1)
     (handle-int16 in))
    ((= byte #xd2)
     (handle-int32 in))
    ((= byte #xd3)
     (handle-int64 in))
    ((= byte #xd4)
     (handle-fixext1 in))
    ((= byte #xd5)
     (handle-fixext2 in))
    ((= byte #xd6)
     (handle-fixext4 in))
    ((= byte #xd7)
     (handle-fixext8 in))
    ((= byte #xd8)
     (handle-fixext16 in))
    ((= byte #xd9)
     (handle-str8 in))
    ((= byte #xda)
     (handle-str16 in))
    ((= byte #xdb)
     (handle-str32 in))
    ((= byte #xdc)
     (handle-array16 in))
    ((= byte #xdd)
     (handle-array32 in))
    ((= byte #xde)
     (handle-map16 in))
    ((= byte #xdf)
       (handle-map32 in))
    ((and (>= byte #xe0) (<= byte #xff))
     (handle-negative-fixint in))
    (t (error 'malformated-msgpack-error :text (format nil "unknown ctrol bytes: ~x" byte)))))

(defun decode-msgpack-file (file)
  (handler-case
      (progn
        (with-open-file (in file :direction :input :element-type '(unsigned-byte 8))
          (let ((byte (read-byte in nil)))
            (handle-control-byte byte in))))
    (malformated-msgpack-error (e)
      (format t "msgpack Error: ~S ~%" (text e)))
    (simple-type-error (e)
      (format t "the simple type error: ~S ~%" e))))

(defun radix-values (radix)
  (assert (<= 2 radix 35)
          (radix)
          "RADIX must be between 2 and 35 (inclusive), not ~D." radix)
  (make-array radix
              :displaced-to "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
              :displaced-index-offset 0
              :element-type
              #+lispworks 'base-char
              #-lispworks 'character))

(defun decode-msgpack-textfile (file)
  (handler-case
      (let ((radix-array (radix-values 16))
            (integer 0)
            (buf (list)))
        (with-open-file (in file :direction :input)
          (labels ((peek () (peek-char nil in nil nil nil))
                   (next () (read-char in nil nil nil))
                   (integer-part ()
                     (cond
                       ((null (peek))
                        (done))
                       ((position (char-upcase (peek)) radix-array)
                        (setf integer (+ (* integer 16)
                                         (position (char-upcase (next)) radix-array)))
                        (return-from integer-part (integer-part)))
                       ((or (char= #\Space (peek))
                            (char= #\linefeed (peek))
                            (char= #\return (peek)))
                        (push integer buf)
                        (setf integer 0)
                        (dotimes (i 10)
                          (when (and (not (null (peek)))
                                     (or (char= #\Space (peek))
                                         (char= #\linefeed (peek))
                                         (char= #\return (peek))))
                              (next)))
                        (return-from integer-part (integer-part)))
                       (t (done))))
                   (done () ;; done
                     (return-from done buf)))
            (integer-part))
          (setf buf (reverse buf))
          ;;;(format t "~{~x ~}" buf)
          (with-open-file (out "/tmp/msgpack.data" :direction :output :element-type '(unsigned-byte 8) :if-exists :supersede)
            (mapcar #'(lambda (x) (write-byte x out)) buf)))
        (decode-msgpack-file "/tmp/msgpack.data"))
    (malformated-msgpack-error (e)
      (format t "msgpack Error: ~S ~%" (text e)))
    (simple-type-error (e)
      (format t "the simple type error: ~S ~%" e))))
  
(defun help (name)
 (format t "Usage: ~%~a [options] ~%" name)
 (format t "~%options:~%")
 (format t "    -b binary-file ~%")
 (format t "    -t text-file ~%"))

(defun main (argv)
  (if (null (rest argv))
  	  (progn
	   (format t "please input the msgpack data file!~%")
	   (help (car argv)))
      (let ((arg1 (car (rest argv)))
            (arg2 (cadr (rest argv))))
        (cond
          ((null arg2)
           (help (car argv)))
          ((string= "-b" arg1)
           (decode-msgpack-file arg2))
          ((string= "-t" arg1)
           (decode-msgpack-textfile arg2))
          ((or (string= "--help" arg2)
               (string= "-h" arg2))
           (help (car argv)))
          (t (format t "unknown arg: ~S~%" arg1)
             (help (car argv)))))))
